home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Desktop Improver / IconTools / source / SwapColors.f < prev   
Encoding:
FORTH Source  |  1996-09-27  |  4.2 KB  |  182 lines
  1. \ $VER: SwapColors.f 1.01 (19 Jan 1992 23:28)
  2. \ Program to swap the colors 2 and 3 of a number icons simultaneously,
  3. \   using the Workbench and Intuition.
  4. \ Written in JForth Professional 2.0
  5. \
  6. \ (c) Copyright 1992 by Richard Mazzarisi
  7. \    All rights reserved.
  8. \
  9. \ address:
  10. \    891 Post St. #207
  11. \    San Francisco, CA
  12. \    94109
  13. \
  14. \  email:
  15. \    rich@californium.cchem.berkeley.edu
  16. \    rmazz@hydrogen.cchem.berkeley.edu
  17. \    nmr@garnet.berkeley.edu
  18. \
  19. \
  20. \ v. 1.00 1/11/92
  21. \      1/13/92  moved the resource management routines to IconTools.f
  22. \ v. 1.01 1/19/92  recompiled with new IconTools.f (cf)
  23. \
  24. \ Instructions:
  25. \ 1 - Click on the icon for this program.
  26. \ 2 - Shift click on all icons to be changed.
  27. \
  28. \ (NOTE: The author assumes no responsibility for any damages
  29. \ resulting from the use of this program.)
  30.  
  31.  
  32. INCLUDE? TASK-ICONTOOLS ICONTOOLS.F
  33.  
  34.  
  35. ANEW task-swapcolors
  36.  
  37. DECIMAL
  38.  
  39.  
  40. \ *** main window stuff ***
  41.  
  42. : open.sc-window    ( -- window/null )
  43.     getWBscreendata
  44.     it-newwindow NEWWINDOW.SETUP
  45.     20 16 set.vert-params
  46.     it-newwindow ..! nw_Height
  47.     it-newwindow ..! nw_TopEdge
  48.     20 52 set.horiz-params
  49.     it-newwindow ..! nw_Width
  50.     it-newwindow ..! nw_LeftEdge
  51.     0" SwapColors  1.01" >ABS it-newwindow ..! nw_Title
  52.     CLOSEWINDOW it-newwindow ..! nw_IDCMPFlags
  53.     WINDOWCLOSE WINDOWDRAG | WINDOWDEPTH | WINDOWSIZING | ACTIVATE |
  54.         it-newwindow ..! nw_Flags
  55.     it-newwindow GR.OPENCURW
  56. ;
  57.  
  58.  
  59. \ *** support ***
  60.  
  61. : sc.greeting        ( -- )
  62.     " Swap colors 1 and 2 in the Image of Icons." con.write.itl con.cr
  63.     " © Copyright by Richard Mazzarisi 1992" con.write.c3 con.cr
  64.     "          All rights reserved." con.write.c3 con.cr
  65.     "      Written in JForth Professional 2.0." con.write.c3 con.cr con.cr
  66. ;
  67.  
  68.  
  69. : prt.sc-instr        ( -- )
  70.     " Instructions:"  con.write con.cr
  71.     " 1 - Click on the icon for this program."  con.write con.cr
  72.     " 2 - Shift click on all icons to be changed."  con.write con.cr con.cr
  73.     " (NOTE: The author assumes no responsibility for any"
  74.     con.write con.cr
  75.     " damages resulting from the use of this program.)" con.write con.cr
  76. ;
  77.  
  78.  
  79. : swap.1-2       { gadimage | nwords plane0 plane1 -- }
  80.         gadimage ..@ ig_Width  15 +  16 /            \ # 16 bit words across
  81.         gadimage ..@ ig_Height  * -> nwords
  82.         gadimage ..@ ig_ImageData  >REL DUP -> plane0
  83.         nwords 2* ( offset in bytes ) + -> plane1
  84.         nwords 0 DO
  85.             \ swapping the planes will swap colors 1 & 2
  86.             \ ie.  {0101,0011} -> {0011,0101} or 0->0 1->2 2->1 3->3
  87.                 plane0 W@  plane1 W@
  88.                 plane0 W!  plane1 W!
  89.                 no@  2 plane0 +!  2 plane1 +!  yes@
  90.         LOOP
  91. ;
  92.  
  93.  
  94. : swap.it    { | icongad -- }
  95.     PAD $it.get-icon
  96.     theICON @ .. do_Gadget  DUP -> icongad
  97.     ..@ gg_GadgetRender >REL
  98.     \ check for a 4 colors and whether it is an image (not border)
  99.     DUP ..@ ig_Depth 2 =
  100.     icongad ..@ gg_Flags  GADGIMAGE AND  0>  AND  IF
  101.         swap.1-2
  102.         \ check for highlight image
  103.         icongad ..@ gg_Flags  GADGHIGHBITS AND  GADGHIMAGE = IF
  104.             icongad ..@ gg_SelectRender >REL  swap.1-2
  105.         THEN
  106. [ clone-it @ ] .IF
  107.         PAD $it.save-icon
  108. .ELSE
  109. \ don't really do it if we are testing things in the interpreter
  110.         it.abort-icon
  111. .THEN
  112.         ELSE
  113.             "    Not a 4 color image!  Not changed." con.write con.cr
  114.             DROP
  115.         it.abort-icon
  116.         THEN
  117. ;
  118.  
  119.  
  120. : swap.one    { wb-arg -- }
  121.     \ get file's path name
  122.     wb-arg get.full-path IF
  123.         "   " con.write
  124.         PAD con.write con.cr
  125.         swap.it
  126.     ELSE
  127.         " ERROR: Could not get path for icon:" con.write.itl con.cr
  128.         "   " con.write
  129.         wreq @ wb-arg ..@ wa_Name >REL ConPutStr() con.cr
  130.     THEN
  131. ;
  132.  
  133.  
  134. : do.swaps    { #args -- }
  135.     \ go thru icons to be changed
  136.         " Click closebox to abort."  con.write con.cr con.cr
  137.     " Swapping the colors for:" con.write con.cr
  138.         \ get pointer to args
  139.     WBMESSAGE @ >REL ..@ sm_ArgList >REL
  140.     \ 2nd and on are the icons to work on
  141.     #args 1+  1  DO
  142.                 DUP  SizeOf() WBArg  I *  +
  143.                 swap.one
  144.         \ check for stop action
  145.         ?CLOSEBOX IF LEAVE THEN
  146.     LOOP
  147.     DROP
  148.     con.cr " Done.  " con.write.itl
  149. ;
  150.  
  151.  
  152. \ *** main ***
  153.  
  154. : swapcolors        ( -- )
  155.     ' prt.sc-instr IS prt.it-instr
  156.     ' open.sc-window IS open.it-window
  157.     open.it-things
  158.     cursor.off
  159.     sc.greeting
  160.     check.WB
  161.     2 check.num.args IF
  162.         do.swaps
  163.     THEN
  164.     close.it-things
  165. ;
  166.  
  167.  
  168. : sc
  169.     swapcolors
  170. ;
  171.  
  172.  
  173. clone-it @ .IF
  174.  
  175. initclone
  176. clone swapcolors
  177. save-image swapcolors SwapColors -icon
  178.  
  179. .THEN
  180.  
  181. CR CR ." Type 'sc to run." CR CR
  182.